SuperHack/SuperHack CD.bin/CODING/VBASIC/MCSECURE.ZIP/MCSECURE.BAS

BASIC Source File | 1996-08-25 | 6.1 KB | 234 lines

Attribute VB_Name = "SECURITY_bas"
Option Explicit

Public Const ApplicationName = "MC-SECURITY"

Public DirectoryForApplication      As String
Public SelectedLanguage             As String
Public CurrentLanguage              As Integer
Public SaveTitleForm                As String

Public FileToUse                    As String

Public SERIALDATA                   As tagSERIALDATA


Sub FileProcessAdd()

   Dim ErrCode          As Integer
   Dim WasSerial        As Integer

   ' get the full name to use
   FileToUse = GetFileToUse()

   ' if no file selected, stop
   If (Len(FileToUse) = 0) Then Exit Sub

   ' check if file is serialized
   WasSerial = cIsSerial(FileToUse)

   ' format the serial number field
   frmSerialization.SerNumber.Text = Val(frmSerialization.SerNumber.Text)

   ' set the serialization info from fields
   SERIALDATA.Description1 = frmSerialization.SerPart1.Text
   SERIALDATA.Description2 = frmSerialization.SerPart2.Text
   SERIALDATA.Number = frmSerialization.SerNumber.Text
   ' put the serialization info
   ErrCode = cSerialPut(FileToUse, SERIALDATA)

   ' check if file was been serialized
   Select Case WasSerial
      Case True
         ' no, display the message
         Call MessageDisplay("3", FileToUse)
      Case False
         ' yes, display the message
         Call MessageDisplay("2", FileToUse)
      Case Else
         ' error
         Call MessageDisplay("6", FileToUse)
   End Select

End Sub

Sub FileProcessChange()

   Dim ErrCode          As Integer

   ' get the full name to use
   FileToUse = GetFileToUse()

   ' if no file selected, stop
   If (Len(FileToUse) = 0) Then Exit Sub

   ' check if file is serialized
   If (cIsSerial(FileToUse) = 0) Then
      ' no, display error
      Call MessageDisplay("1", FileToUse)

   Else
      ' yes, add 1 to serial number
      ErrCode = cSerialInc(FileToUse, 1)
      ' read the serialization info
      ErrCode = cSerialGet(FileToUse, SERIALDATA)
      ' set the serialization info on fields
      frmSerialization.SerPart1.Text = SERIALDATA.Description1
      frmSerialization.SerPart2.Text = SERIALDATA.Description2
      frmSerialization.SerNumber.Text = SERIALDATA.Number
      ' check the serial number, for example MOD 10
      If ((SERIALDATA.Number Mod 10) = 0) Then
         ' yes, modulo 10, display message
         Call MessageDisplay("4", FileToUse)
      End If

   End If

End Sub

Sub FileProcessRead()

   Dim ErrCode          As Integer

   ' get the full name to use
   FileToUse = GetFileToUse()

   ' if no file selected, stop
   If (Len(FileToUse) = 0) Then Exit Sub

   ' check if file is serialized
   If (cIsSerial(FileToUse) = 0) Then
      ' no, display error
      Call MessageDisplay("1", FileToUse)

   Else
      ' yes, display the serialization info
      ErrCode = cSerialGet(FileToUse, SERIALDATA)
      ' set the serialization info on fields
      frmSerialization.SerPart1.Text = SERIALDATA.Description1
      frmSerialization.SerPart2.Text = SERIALDATA.Description2
      frmSerialization.SerNumber.Text = SERIALDATA.Number

   End If

End Sub

Sub FileProcessRemove()

   Dim ErrCode          As Integer

   ' get the full name to use
   FileToUse = GetFileToUse()

   ' if no file selected, stop
   If (Len(FileToUse) = 0) Then Exit Sub

   ' check if file is serialized
   If (cIsSerial(FileToUse) = 0) Then
      ' no, display error
      Call MessageDisplay("1", FileToUse)

   Else
      ' yes, remove the serialization info
      ErrCode = cSerialRmv(FileToUse)
      ' display remove message
      Call MessageDisplay("5", FileToUse)

   End If

End Sub

Function GetFileToUse() As String

   ' check if a file has been selected
   If (frmSerialization.File1.ListIndex >= 0) Then
      ' yes, form the full name
      GetFileToUse = frmSerialization.File1.Path + "\" + frmSerialization.File1.List(frmSerialization.File1.ListIndex)

   Else

      Call MessageDisplay("0", "")

      ' no, return empty
      GetFileToUse = ""

   End If

End Function

Sub Loader()

   DoEvents

   ' some initializations
   DirectoryForApplication = App.Path + "\"

   ' save the caption of this form
   SaveTitleForm = frmSerialization.Caption

End Sub

Sub MessageDisplay(TextOrder As String, InsertText As String)

   ' display a multi-language message box, message are centered
   ' and a timeout of 30 seconds is displayed.
   MsgBox ReadText(TextOrder, InsertText), vbOKOnly, SaveTitleForm

   frmSerialization.ZOrder 0

End Sub

Function ReadText(TextOrder As String, InsertText As String) As String

   Dim i                As Integer
   Dim n                As Integer
   Dim Tmp              As String
   Dim BasisText        As String

   Select Case TextOrder
      Case "0": BasisText = "You must select a file !"
      Case "1": BasisText = "File '~' is not a serialized file !"
      Case "2": BasisText = "File '~' is now serialized."
      Case "3": BasisText = "File '~' was serialized.ººSerialization has been updated."
      Case "4": BasisText = "Message sample.ººYou've tried this program more than 10 uses.ººRegister this program.ººMessage sample."
      Case "5": BasisText = "Serialization information on file '~' has been removed."
      Case "6": BasisText = "Error when accessing the file '~'."
   End Select

   ' insert some text if any
   n = InStr(BasisText, "~")
   If (n > 0) Then
      Tmp = Left$(BasisText, n - 1) + InsertText + Mid$(BasisText, n + 1)
   Else
      Tmp = BasisText
   End If

   ' change all º to make a CR
   n = 0
   n = InStr(n + 1, Tmp, "º")
   Do While (n > 0)
      Mid$(Tmp, n, 1) = vbCr
      n = InStr(n + 1, Tmp, "º")
   Loop

   ReadText = Tmp

End Function


Public Function RemoveNull(sStr As String) As String

   Dim i       As Integer
   Dim n       As Integer
   Dim s       As String

   s = sStr
   n = Len(s)
   For i = 1 To n
      If (Asc(Mid$(s, i, 1)) = 0) Then Mid$(s, i, 1) = " "
   Next i

   RemoveNull = s

End Function